home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / util / cdity / ShutWB.lha / ShutWB / ShutWB.mod < prev    next >
Text File  |  1993-10-18  |  4KB  |  178 lines
  1. MODULE ShutWB;
  2.  
  3. (*
  4.  
  5.    ShutWB 1.0    (13.10.1993)
  6.  
  7.    by Carsten Orthbandt
  8.  
  9.    Compiler: Amiga Oberon 3.0
  10.  
  11. *)
  12.  
  13.  
  14.  
  15.  
  16. IMPORT e:Exec,
  17.        es:ExecSupport,
  18.        cx:Commodities,
  19.        conv:Conversions,
  20.        y:SYSTEM,
  21.        d:Dos,
  22.        wb:Workbench,
  23.        ol:OberonLib,
  24.        I: Intuition,
  25.        u: Utility,
  26.        ic:Icon;
  27.  
  28. VAR
  29.      PopKey:ARRAY 100 OF CHAR;
  30.      MyBrk :cx.CxObjPtr;
  31.      MyFil :cx.CxObjPtr;
  32.      MySnd :cx.CxObjPtr;
  33.      MyTrs :cx.CxObjPtr;
  34.      NwBrk :cx.NewBroker;
  35.      MsPrt :e.MsgPortPtr;
  36.      Quit  :BOOLEAN;
  37.      Shut  :BOOLEAN;
  38.      Err   :LONGINT;
  39.      eMsg  :e.APTR;
  40.      Msg   :cx.CxMsgPtr;
  41.      MsTp  :LONGSET;
  42.      MsId  :LONGINT;
  43.      CxPri :LONGINT;
  44.      CxKey :ARRAY 254 OF CHAR;
  45.      Signal:LONGSET;
  46.  
  47. PROCEDURE GetToolTypes;
  48. VAR This:d.ProcessPtr;
  49.     wbm:wb.WBStartupPtr;
  50.     sptr:e.STRPTR;
  51.     MyIcon:wb.DiskObjectPtr;
  52.     OCurrentDir:d.FileLockPtr;
  53. BEGIN;
  54. This:=y.VAL(d.ProcessPtr,ol.Me);
  55. CxPri:=0;CxKey:="alt control w";
  56. IF ol.wbStarted THEN
  57.  wbm:=ol.wbenchMsg;
  58.  OCurrentDir:=This.currentDir;
  59.  y.SETREG(0,d.CurrentDir(wbm.argList[0].lock));
  60.  MyIcon := ic.GetDiskObject(wbm.argList[0].name^);
  61.  y.SETREG(0,d.CurrentDir(OCurrentDir));
  62.  IF MyIcon#NIL THEN
  63.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_PRIORITY");
  64.   IF sptr#NIL THEN IF conv.StringToInt(sptr^,CxPri) THEN END;END;
  65.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_POPKEY");
  66.   IF sptr#NIL THEN COPY(sptr^,CxKey);END;
  67.   ic.FreeDiskObject(MyIcon);
  68.  END;
  69. END;
  70. END GetToolTypes;
  71.  
  72.  
  73. PROCEDURE Disable;
  74. BEGIN;
  75. IF cx.ActivateCxObj(MyBrk,0)#0 THEN END;
  76. END Disable;
  77.  
  78. PROCEDURE Enable;
  79. BEGIN;
  80. IF cx.ActivateCxObj(MyBrk,1)#0 THEN END;
  81. END Enable;
  82.  
  83.  
  84. PROCEDURE Init():BOOLEAN;
  85. VAR ret:BOOLEAN;
  86. BEGIN;
  87. ret:=TRUE;
  88. Shut:=FALSE;
  89. IF ret THEN
  90. MsPrt:=e.CreateMsgPort();
  91. IF MsPrt=NIL THEN ret:=FALSE;END;
  92. IF ret THEN
  93. NwBrk.version:=cx.nbVersion;
  94. NwBrk.name:=y.ADR("ShutWB");
  95. NwBrk.title:=y.ADR("ShutWB 1.0 by HDS");
  96. NwBrk.descr:=y.ADR("Close WB by shortcut");
  97. NwBrk.unique:=SET{0,1};
  98. NwBrk.flags:=SET{};
  99. NwBrk.pri:=SHORT(SHORT(CxPri));
  100. NwBrk.port:=MsPrt;
  101. NwBrk.reservedChannel:=0;
  102. MyBrk:=cx.CxBroker(NwBrk,Err);
  103. IF Err#0 THEN ret:=FALSE;END;
  104. IF ret THEN
  105. MyFil:=cx.CxFilter(y.ADR(CxKey));
  106. MySnd:=cx.CxSender(MsPrt,cx.cxmIEvent);
  107. MyTrs:=cx.CxTranslate(NIL);
  108. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  109. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  110. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  111. cx.AttachCxObj(MyBrk,MyFil);
  112. cx.AttachCxObj(MyFil,MySnd);
  113. cx.AttachCxObj(MyFil,MyTrs);
  114. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  115. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  116. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  117. IF cx.ActivateCxObj(MyBrk,1)#0 THEN ret:=FALSE;END;
  118. IF MyFil=NIL THEN ret:=FALSE;END;
  119. IF MySnd=NIL THEN ret:=FALSE;END;
  120. IF MyTrs=NIL THEN ret:=FALSE;END;
  121. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  122. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  123. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  124. END;END;END;
  125. RETURN (ret);
  126. END Init;
  127.  
  128. PROCEDURE ShutDown;
  129. BEGIN;
  130. IF MyBrk#NIL THEN cx.DeleteCxObjAll(MyBrk);
  131. REPEAT;UNTIL e.GetMsg(MsPrt)=NIL;END;
  132. IF MsPrt#NIL THEN
  133. e.DeleteMsgPort(MsPrt);END;
  134. END ShutDown;
  135.  
  136. PROCEDURE CheckCx;
  137. BEGIN;
  138. IF MsPrt#NIL THEN
  139. REPEAT;
  140. eMsg:=e.GetMsg(MsPrt);
  141. IF eMsg#NIL THEN
  142. Msg:=y.VAL(cx.CxMsgPtr,eMsg);
  143. MsTp:=cx.CxMsgType(Msg);
  144. MsId:=cx.CxMsgID(Msg);
  145. e.ReplyMsg(eMsg);
  146.  IF MsTp=LONGSET{cx.cxmIEvent} THEN
  147.   IF Shut THEN
  148.    Shut:=FALSE;
  149.    IF I.OpenWorkBench()=NIL THEN I.DisplayBeep(NIL);END;
  150.   ELSE
  151.    Shut:=TRUE;
  152.    IF ~I.CloseWorkBench() THEN I.DisplayBeep(NIL);END;
  153.   END;END;
  154.  IF MsTp=LONGSET{cx.cxmCommand} THEN
  155.   IF MsId=cx.cmdDisable THEN Disable;END;
  156.   IF MsId=cx.cmdEnable THEN Enable;END;
  157.   IF MsId=cx.cmdKill THEN Quit:=TRUE;END;
  158.   IF MsId=cx.cmdUnique THEN Quit:=TRUE;END;
  159.  END;
  160. END;
  161. UNTIL eMsg=NIL;
  162. END;
  163. END CheckCx;
  164.  
  165. BEGIN;
  166. GetToolTypes;
  167. IF Init() THEN
  168. Enable;
  169. CheckCx;
  170. REPEAT;
  171. e.WaitPort(MsPrt);
  172. CheckCx;
  173. UNTIL Quit;
  174. END;
  175. ShutDown;
  176. END ShutWB.
  177.  
  178.